home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s3.arc / PIBMENUS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-03  |  44.3 KB  |  965 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           PIBMENUS.PAS   --- Menu Routines for Turbo Pascal          *)
  3. (*----------------------------------------------------------------------*)
  4. (*                                                                      *)
  5. (*  Author:  Philip R. Burns                                            *)
  6. (*                                                                      *)
  7. (*  Date:    Version 1.0: January, 1985                                 *)
  8. (*           Version 1.1: March, 1985                                   *)
  9. (*           Version 1.2: May, 1985                                     *)
  10. (*           Version 2.0: June, 1985                                    *)
  11. (*           Version 2.1: July, 1985                                    *)
  12. (*           Version 3.0: October, 1985                                 *)
  13. (*           Version 3.2: November, 1985                                *)
  14. (*                                                                      *)
  15. (*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
  16. (*           Note:  I have checked these on Zenith 151s under           *)
  17. (*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
  18. (*                                                                      *)
  19. (*  History: These routines represent my substantial upgrading of the   *)
  20. (*           simple menu routines written by Barry Abrahamsen which     *)
  21. (*           I believe appeared originally in the TUG newsletter.       *)
  22. (*           The windowing facility provides windows similar to those   *)
  23. (*           implemented in QMODEM by John Friel III.                   *)
  24. (*                                                                      *)
  25. (*           Version 2.0 of these adds the exploding windows feature    *)
  26. (*           as well the use-selectable box-drawing characters.         *)
  27. (*           The exploding box algorithm is derived from one by         *)
  28. (*           Jim Everingham.                                            *)
  29. (*                                                                      *)
  30. (*           Note that the routines present in PIBSCREN.PAS were        *)
  31. (*           originally part of the PIBMENUS.PAS file.  With version    *)
  32. (*           2.0 of PibMenus, PIBMENUS.PAS is split into the screen-    *)
  33. (*           handling routines in PIBSCREN.PAS and the actual menu      *)
  34. (*           routines in PIBMENUS.PAS.                                  *)
  35. (*                                                                      *)
  36. (*           Suggestions for improvements or corrections are welcome.   *)
  37. (*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
  38. (*           or Ron Fox's BBS (312) 940 6496.                           *)
  39. (*                                                                      *)
  40. (*           If you use this code in your own programs, please be nice  *)
  41. (*           and give all of us credit.                                 *)
  42. (*                                                                      *)
  43. (*----------------------------------------------------------------------*)
  44. (*                                                                      *)
  45. (*  Needs:  These routines need the include files MINMAX.PAS,           *)
  46. (*          GLOBTYPE.PAS, ASCII.PAS, and PIBSCREN.PAS. These files      *)
  47. (*          are not included here, since Turbo Pascal regrettably does  *)
  48. (*          not allow nested includes.                                  *)
  49. (*                                                                      *)
  50. (*----------------------------------------------------------------------*)
  51. (*                                                                      *)
  52. (*  What these routines do:                                             *)
  53. (*                                                                      *)
  54. (*    These routines provide a straight-forward menu-selection          *)
  55. (*    facility, similar to that used in programs like Lotus.  A pop-up  *)
  56. (*    window holds the menu.  The menu is contained in a frame.  The    *)
  57. (*    items are displayed within the frame.  The currently selected     *)
  58. (*    item is highlighted in reverse video.  You move up and down in    *)
  59. (*    the list of menu items by using the up and down arrow keys, or    *)
  60. (*    the space bar.  To make a selection, hit the Enter (Return) key.  *)
  61. (*                                                                      *)
  62. (*    Alternatively, you may hit the first character of a menu item.    *)
  63. (*    The first menu item found with that initial letter is selected.   *)
  64. (*                                                                      *)
  65. (*    The characters comprising the menu box are user-selectable.       *)
  66. (*    In addition, menus may just "pop up" onto the screen, or may      *)
  67. (*    "explode" onto the screen.                                        *)
  68. (*                                                                      *)
  69. (*----------------------------------------------------------------------*)
  70. (*                                                                      *)
  71. (*  Use:                                                                *)
  72. (*                                                                      *)
  73. (*     (1)  Define a variable of type Menu_Type, say, MYMENU.           *)
  74. (*                                                                      *)
  75. (*     (2)  Define the following entries in MYMENU:                     *)
  76. (*                                                                      *)
  77. (*             Menu_Size    --- Number of entries in this menu          *)
  78. (*             Menu_Title   --- Title for the menu                      *)
  79. (*             Menu_Row     --- Row where menu should appear (upper LHC *)
  80. (*             Menu_Column  --- Column where menu should appear         *)
  81. (*             Menu_Width   --- Width of menu                           *)
  82. (*             Menu_Height  --- Height of menu                          *)
  83. (*             Menu_Default --- Ordinal of the default menu entry       *)
  84. (*             Menu_Tcolor  --- Color to display menu text              *)
  85. (*             Menu_Bcolor  --- Color for menu background               *)
  86. (*             Menu_Fcolor  --- Color for menu frame box                *)
  87. (*                                                                      *)
  88. (*     (3)  Now for each of Menu_Size Menu_Entries, define:             *)
  89. (*             Menu_Text   --- Text of menu item                        *)
  90. (*                                                                      *)
  91. (*     (4)  Optionally call  Menu_Set_Box_Chars  to define the          *)
  92. (*          characters used to form the menu box.                       *)
  93. (*                                                                      *)
  94. (*     (5)  Optionally call Menu_Set_Explode to set the menus as either *)
  95. (*          exploding or pop-up.                                        *)
  96. (*                                                                      *)
  97. (*     (6)  Optionally call Menu_Set_Beep to turn beeping on/off.       *)
  98. (*                                                                      *)
  99. (*     (7)  Call  Menu_Display_Choices  to display menu.  The default   *)
  100. (*          menu choice will be highlighted.                            *)
  101. (*                                                                      *)
  102. (*     (8)  Call  Menu_Get_Choice  to retrieve menu choice.  The up and *)
  103. (*          down arrows, and the space bar, can be used to move         *)
  104. (*          through the menu items.  Each item is highlighted in turn.  *)
  105. (*          Whichever item is highlighted when a carriage return is     *)
  106. (*          entered is returned as the chosen item.                     *)
  107. (*                                                                      *)
  108. (*----------------------------------------------------------------------*)
  109.  
  110. (*----------------------------------------------------------------------*)
  111. (*                   Menu constants, types, and variables               *)
  112. (*----------------------------------------------------------------------*)
  113.  
  114. CONST
  115.  
  116.    Up_arrow         = ^E;    (* move up in menu code   *)
  117.    Down_arrow       = ^X;    (* move down in menu code *)
  118.    Space_bar        = #32;   (* space bar              *)
  119.    Ch_cr            = #13;   (* Carriage return *)
  120.    Ch_esc           = #27;   (* Escape *)
  121.    Ch_bell          = #07;   (* Bell *)
  122.  
  123.    Max_Menu_Items   = 19;    (* Maximum number of menu choices *)
  124.  
  125.    Dont_Erase_Menu  = FALSE;
  126.    Erase_Menu       = TRUE;
  127.  
  128. TYPE
  129.  
  130.    String40   = STRING[40]         (* Menu entry string type               *);
  131.    String80   = STRING[80]         (* Menu title string type               *);
  132.  
  133.    Menu_Entry = RECORD
  134.       Menu_Item_Text   : String40; (* Text of entry                        *)
  135.       Menu_Item_Row    : BYTE;     (* Row position of menu item            *)
  136.       Menu_Item_Column : BYTE;     (* Column position of menu item         *)
  137.    END;
  138.  
  139.    Menu_Type = RECORD
  140.       Menu_Size     : 1 .. Max_Menu_Items;    (* No. of items in menu      *)
  141.       Menu_Title    : String80;               (* Menu title                *)
  142.       Menu_Row      : BYTE;                   (* Row position of menu      *)
  143.       Menu_Column   : BYTE;                   (* Column position of menu   *)
  144.       Menu_Width    : BYTE;                   (* Width of menu             *)
  145.       Menu_Height   : BYTE;                   (* Height of menu            *)
  146.       Menu_Default  : 1 .. Max_Menu_Items;    (* Default value position    *)
  147.       Menu_TColor   : BYTE;                   (* Foreground text color     *)
  148.       Menu_BColor   : BYTE;                   (* BackGround color          *)
  149.       Menu_FColor   : BYTE;                   (* Frame color               *)
  150.  
  151.                                               (* Menu items themselves     *)
  152.       Menu_Entries  : ARRAY[ 1 .. Max_Menu_Items ] Of Menu_Entry;
  153.    END;
  154.  
  155. (* STRUCTURED *) CONST
  156.    Menu_Explode_Mode : BOOLEAN     (* TRUE to use exploding menus *)
  157.                        = FALSE;
  158.  
  159.    Menu_Beep_Mode    : BOOLEAN     (* TRUE to beep on errors      *)
  160.                        = TRUE;
  161.  
  162. (* STRUCTURED *) CONST
  163.                                    (* Box-drawing characters for menus *)
  164.    Menu_Box_Chars : RECORD
  165.                        Top_Left_Corner     : CHAR;
  166.                        Top_Line            : CHAR;
  167.                        Top_Right_Corner    : CHAR;
  168.                        Right_Line          : CHAR;
  169.                        Bottom_Right_Corner : CHAR;
  170.                        Bottom_Line         : CHAR;
  171.                        Bottom_Left_Corner  : CHAR;
  172.                        Left_Line           : CHAR;
  173.                     END
  174.                     =
  175.                     (  Top_Left_Corner     : '╒';
  176.                        Top_Line            : '═';
  177.                        Top_Right_Corner    : '╕';
  178.                        Right_Line          : '│';
  179.                        Bottom_Right_Corner : '╛';
  180.                        Bottom_Line         : '═';
  181.                        Bottom_Left_Corner  : '╘';
  182.                        Left_Line           : '│'  );
  183.  
  184. (*----------------------------------------------------------------------*)
  185. (*            Menu_Set_Explode --- Set explode mode on or off           *)
  186. (*----------------------------------------------------------------------*)
  187.  
  188. PROCEDURE Menu_Set_Explode( Explode_ON : BOOLEAN );
  189.  
  190. (*----------------------------------------------------------------------*)
  191. (*                                                                      *)
  192. (*     Procedure:  Menu_Set_Explode                                     *)
  193. (*                                                                      *)
  194. (*     Purpose:    Turn exploding menus on or off                       *)
  195. (*                                                                      *)
  196. (*     Calling Sequence:                                                *)
  197. (*                                                                      *)
  198. (*        Menu_Set_Explode( Explode_ON : BOOLEAN );                     *)
  199. (*                                                                      *)
  200. (*           Explode_ON --- TRUE to use exploding menus,                *)
  201. (*                          FALSE to use pop-up menus                   *)
  202. (*                                                                      *)
  203. (*     Calls:   None                                                    *)
  204. (*                                                                      *)
  205. (*----------------------------------------------------------------------*)
  206.  
  207. BEGIN (* Menu_Set_Explode *)
  208.  
  209.    Menu_Explode_Mode := Explode_ON;
  210.  
  211. END   (* Menu_Set_Explode *);
  212.  
  213. (*----------------------------------------------------------------------*)
  214. (*               Menu_Set_Beep --- Set beep mode on or off              *)
  215. (*----------------------------------------------------------------------*)
  216.  
  217. PROCEDURE Menu_Set_Beep( Beep_ON : BOOLEAN );
  218.  
  219. (*----------------------------------------------------------------------*)
  220. (*                                                                      *)
  221. (*     Procedure:  Menu_Set_Beep                                        *)
  222. (*                                                                      *)
  223. (*     Purpose:    Turn beeping (errors, etc.) on or off                *)
  224. (*                                                                      *)
  225. (*     Calling Sequence:                                                *)
  226. (*                                                                      *)
  227. (*        Menu_Set_Beep( Beep_ON : BOOLEAN );                           *)
  228. (*                                                                      *)
  229. (*           Beep_ON --- TRUE to allow beeps,                           *)
  230. (*                       FALSE to disallow beeps.                       *)
  231. (*                                                                      *)
  232. (*     Calls:   None                                                    *)
  233. (*                                                                      *)
  234. (*----------------------------------------------------------------------*)
  235.  
  236. BEGIN (* Menu_Set_Beep *)
  237.  
  238.    Menu_Beep_Mode := Beep_ON;
  239.  
  240. END   (* Menu_Set_Beep *);
  241.  
  242. (*----------------------------------------------------------------------*)
  243. (*     Menu_Set_Box_Chars --- Set box drawing characters for menus      *)
  244. (*----------------------------------------------------------------------*)
  245.  
  246. PROCEDURE Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;
  247.                               Top_Line            : CHAR;
  248.                               Top_Right_Corner    : CHAR;
  249.                               Right_Line          : CHAR;
  250.                               Bottom_Right_Corner : CHAR;
  251.                               Bottom_Line         : CHAR;
  252.                               Bottom_Left_Corner  : CHAR;
  253.                               Left_Line           : CHAR  );
  254.  
  255. (*----------------------------------------------------------------------*)
  256. (*                                                                      *)
  257. (*     Procedure:  Menu_Set_Box_Chars                                   *)
  258. (*                                                                      *)
  259. (*     Purpose:    Set box characters for drawing menu boxes            *)
  260. (*                                                                      *)
  261. (*     Calling Sequence:                                                *)
  262. (*                                                                      *)
  263. (*        Menu_Set_Box_Chars( Top_Left_Corner     : CHAR;               *)
  264. (*                            Top_Line            : CHAR;               *)
  265. (*                            Top_Right_Corner    : CHAR;               *)
  266. (*                            Right_Line          : CHAR;               *)
  267. (*                            Bottom_Right_Corner : CHAR;               *)
  268. (*                            Bottom_Line         : CHAR;               *)
  269. (*                            Bottom_Left_Corner  : CHAR;               *)
  270. (*                            Left_Line           : CHAR  );            *)
  271. (*                                                                      *)
  272. (*           --- arguments are what their names suggest.                *)
  273. (*                                                                      *)
  274. (*                                                                      *)
  275. (*     Calls:   None                                                    *)
  276. (*                                                                      *)
  277. (*----------------------------------------------------------------------*)
  278.  
  279. BEGIN (* Menu_Set_Box_Chars *)
  280.  
  281.    Menu_Box_Chars.Top_Left_Corner     := Top_Left_Corner;
  282.    Menu_Box_Chars.Top_Line            := Top_Line;
  283.    Menu_Box_Chars.Top_Right_Corner    := Top_Right_Corner;
  284.    Menu_Box_Chars.Right_Line          := Right_Line;
  285.    Menu_Box_Chars.Bottom_Right_Corner := Bottom_Right_Corner;
  286.    Menu_Box_Chars.Bottom_Line         := Bottom_Line;
  287.    Menu_Box_Chars.Bottom_Left_Corner  := Bottom_Left_Corner;
  288.    Menu_Box_Chars.Left_Line           := Left_Line;
  289.  
  290. END   (* Menu_Set_Box_Chars *);
  291.  
  292. (*----------------------------------------------------------------------*)
  293. (*                Draw_Menu_Frame --- Draw a Frame                      *)
  294. (*----------------------------------------------------------------------*)
  295.  
  296. PROCEDURE Draw_Menu_Frame( UpperLeftX,  UpperLeftY,
  297.                            LowerRightX, LowerRightY : INTEGER;
  298.                            Frame_Color, Title_Color : INTEGER;
  299.                            Menu_Title: AnyStr );
  300.  
  301. (*----------------------------------------------------------------------*)
  302. (*                                                                      *)
  303. (*     Procedure:  Draw_Menu_Frame                                      *)
  304. (*                                                                      *)
  305. (*     Purpose:    Draws a titled frame using PC graphics characters    *)
  306. (*                                                                      *)
  307. (*     Calling Sequence:                                                *)
  308. (*                                                                      *)
  309. (*        Draw_Menu_Frame( UpperLeftX,  UpperLeftY,                     *)
  310. (*                         LowerRightX, LowerRightY,                    *)
  311. (*                         Frame_Color, Title_Color : INTEGER;          *)
  312. (*                         Menu_Title: AnyStr );                        *)
  313. (*                                                                      *)
  314. (*           UpperLeftX,  UpperLeftY  --- Upper left coordinates        *)
  315. (*           LowerRightX, LowerRightY --- Lower right coordinates       *)
  316. (*           Frame_Color              --- Color for frame               *)
  317. (*           Title_Color              --- Color for title text          *)
  318. (*           Menu_Title               --- Menu Title                    *)
  319. (*                                                                      *)
  320. (*     Calls:   GoToXY                                                  *)
  321. (*              Window                                                  *)
  322. (*              ClrScr                                                  *)
  323. (*              Dupl                                                    *)
  324. (*              Draw_Box (internal)                                     *)
  325. (*              Do_Explosion (internal)                                 *)
  326. (*                                                                      *)
  327. (*     Remarks:                                                         *)
  328. (*                                                                      *)
  329. (*        The area inside the frame is cleared after the frame is       *)
  330. (*        drawn.  If a box without a title is desired, enter a null     *)
  331. (*        string for a title.                                           *)
  332. (*                                                                      *)
  333. (*----------------------------------------------------------------------*)
  334.  
  335. VAR
  336.    I  : INTEGER;
  337.    L  : INTEGER;
  338.    LT : INTEGER;
  339.    XM : INTEGER;
  340.    YM : INTEGER;
  341.    XS : INTEGER;
  342.    YS : INTEGER;
  343.    R  : REAL;
  344.    X1 : INTEGER;
  345.    X2 : INTEGER;
  346.    Y1 : INTEGER;
  347.    Y2 : INTEGER;
  348.    XM1: INTEGER;
  349.    YM1: INTEGER;
  350.    Knt: INTEGER;
  351.  
  352. (*----------------------------------------------------------------------*)
  353.  
  354. PROCEDURE Draw_Box( X1, Y1, X2, Y2 : INTEGER;
  355.                     Frame_Color    : INTEGER;
  356.                     Title_Color    : INTEGER;
  357.                     Title          : AnyStr   );
  358.  
  359. VAR
  360.    I  : INTEGER;
  361.    LT : INTEGER;
  362.  
  363. BEGIN (* Draw_Box *)
  364.  
  365.    Window( 1, 1, 80, 25 );
  366.  
  367.    LT := LENGTH( Title );
  368.  
  369.    IF LT > 0 THEN
  370.       BEGIN
  371.          WriteSXY( Menu_Box_Chars.Top_Left_Corner + '[ ',
  372.                    X1, Y1, Frame_Color );
  373.          WriteSXY( Title, X1 + 3, Y1, Title_Color );
  374.          WriteSXY( ' ]', X1 + LT + 3, Y1, Frame_Color );
  375.       END
  376.    ELSE
  377.       WriteSXY( Menu_Box_Chars.Top_Left_Corner +
  378.                 DUPL( Menu_Box_Chars.Top_Line , 4 ), X1, Y1, Frame_Color );
  379.  
  380.                                    (* Draw remainder of top of frame *)
  381.  
  382.    FOR I := ( X1 + LT + 5 ) TO ( X2 - 1 ) DO
  383.       WriteCXY( Menu_Box_Chars.Top_Line, I, Y1, Frame_Color );
  384.  
  385.    WriteCXY( Menu_Box_Chars.Top_Right_Corner, X2, Y1, Frame_Color );
  386.  
  387.                                   (* Draw sides of frame *)
  388.  
  389.    FOR I := ( Y1 + 1 ) TO ( Y2 - 1 ) DO
  390.       BEGIN
  391.          WriteCXY( Menu_Box_Chars.Left_Line,  X1, I, Frame_Color );
  392.          WriteCXY( Menu_Box_Chars.Right_Line, X2, I, Frame_Color );
  393.       END;
  394.                                   (* Draw bottom of frame     *)
  395.  
  396.    WriteCXY( Menu_Box_Chars.Bottom_Left_Corner, X1, Y2, Frame_Color );
  397.  
  398.    FOR I := ( X1 + 1 ) TO ( X2 - 1 ) DO
  399.       WriteCXY( Menu_Box_Chars.Bottom_Line, I, Y2, Frame_Color );
  400.  
  401.    WriteCXY( Menu_Box_Chars.Bottom_Right_Corner, X2, Y2, Frame_Color );
  402.  
  403. END   (* Draw_Box *);
  404.  
  405. (*----------------------------------------------------------------------*)
  406.  
  407. PROCEDURE Do_Explosion;
  408.  
  409. (*----------------------------------------------------------------------*)
  410. (*               --- Basic algorithm by Jim Everingham ---              *)
  411. (*----------------------------------------------------------------------*)
  412.  
  413. BEGIN (* Do_Explosion *)
  414.  
  415.    XM     := UpperLeftX + L DIV 2;
  416.    YM     := UpperLeftY + ( LowerRightY - UpperLeftY ) DIV 2;
  417.    X1     := UpperLeftX;
  418.    X2     := LowerRightX;
  419.    Y1     := UpperLeftY;
  420.    Y2     := LowerRightY;
  421.  
  422.    XM1    := XM;
  423.    YM1    := YM;
  424.                                     (* Figure out increments for *)
  425.                                     (* increasing boz dimensions *)
  426.                                     (* to produce explosion.     *)
  427.    IF ( XM > YM ) THEN
  428.        Knt    := TRUNC( L / 2 )
  429.    ELSE
  430.        Knt    := TRUNC( ( Y2 - Y1 ) / 2 );
  431.  
  432.    Y1     := Y1 - 1;
  433.    Y2     := Y2 - 1;
  434.  
  435.    X1     := X1 + 1;
  436.    X2     := X2 - 1;
  437.                                    (* Draw series of increasing     *)
  438.                                    (* size boxes, giving appearance *)
  439.                                    (* that box "explodes" from its  *)
  440.                                    (* center.                       *)
  441.  
  442.    FOR I := 1 TO ROUND( Knt / 3 ) DO
  443.       BEGIN
  444.                                    (* Adjust sides *)
  445.  
  446.          IF ( XM > ( X1 - 2 ) ) THEN
  447.             XM := XM - 3
  448.          ELSE IF ( XM > ( X1 - 1 ) ) THEN
  449.             XM := XM - 2
  450.          ELSE IF ( XM > X1 ) THEN
  451.             XM := XM - 1;
  452.  
  453.          IF ( XM1 < ( X2 + 2 ) ) THEN
  454.             XM1 := XM1 + 3
  455.          ELSE IF ( XM1 < ( X2 + 1 ) ) THEN
  456.             XM1 := XM1 + 2
  457.          ELSE IF ( XM1 < X2 ) THEN
  458.             XM1 := XM1 + 1;
  459.  
  460.                                    (* Adjust top and bottom *)
  461.  
  462.          IF ( YM > ( Y1 + 2 ) ) THEN
  463.             YM := YM - 3
  464.          ELSE IF ( YM > ( Y1 + 1 ) ) THEN
  465.             YM := YM - 2
  466.          ELSE IF ( YM > Y1 ) THEN
  467.             YM := YM - 1;
  468.  
  469.          IF ( YM1 < ( Y2 - 2 ) ) THEN
  470.             YM1 := YM1 + 3
  471.          ELSE IF ( YM1 < ( Y2 - 1 ) ) THEN
  472.             YM1 := YM1 + 2
  473.          ELSE IF ( YM1 < Y2 ) THEN
  474.             YM1 := YM1 + 1;
  475.  
  476.                                    (* Define new window *)
  477.  
  478.          WINDOW( XM + 1, YM + 1, XM1, YM1 );
  479.  
  480.                                    (* Clear it out      *)
  481.          Clear_Window;
  482.  
  483.                                    (* Draw box          *)
  484.  
  485.          Draw_Box( XM+1, YM+1, XM1, YM1, Frame_Color, Title_Color, '' );
  486.  
  487.       END (* For *);
  488.  
  489. END   (* Do_Explosion *);
  490.  
  491. (*----------------------------------------------------------------------*)
  492.  
  493. BEGIN (* Draw_Menu_Frame *)
  494.  
  495.    L  := LowerRightX - UpperLeftX;
  496.    LT := LENGTH( Menu_Title );
  497.                                    (* Adjust title length if necessary *)
  498.  
  499.    IF LT > ( L - 5 ) THEN Menu_Title[0] := CHR( L - 5 );
  500.  
  501.                                    (* Get explosion if requested *)
  502.  
  503.    IF Menu_Explode_Mode THEN Do_Explosion;
  504.  
  505.                                    (* Display actual menu frame       *)
  506.  
  507.    Draw_Box( UpperLeftX, UpperLeftY, LowerRightX, LowerRightY,
  508.              Frame_Color, Title_Color, Menu_Title );
  509.  
  510.                                    (* Establish scrolling window area *)
  511.  
  512.    Window( UpperLeftX+1, UpperLeftY+1, LowerRightX-1, LowerRightY-1 );
  513.  
  514.                                    (* Clear out the window area       *)
  515.                                    (* KLUDGE NOTE:  ClrScr doesn't    *)
  516.                                    (* seem to work correctly on mono  *)
  517.                                    (* screens with Turbo 3.0 in the   *)
  518.                                    (* context of PibTerm.             *)
  519. (*
  520.    ClrScr;
  521. *)
  522.    FOR I := 1 TO ( LowerRightY - UpperLeftY - 1 ) DO
  523.       BEGIN
  524.          GoToXY( 1 , I );
  525.          ClrEol;
  526.       END;
  527.  
  528.    GoToXY( 1 , 1 );
  529.                                    (* Ensure proper color for text    *)
  530.    TextColor( Title_Color );
  531.  
  532. END   (* Draw_Menu_Frame *);
  533.  
  534. (*----------------------------------------------------------------------*)
  535. (*                Menu_Click --- Make short click noise                 *)
  536. (*----------------------------------------------------------------------*)
  537.  
  538. PROCEDURE Menu_Click;
  539.  
  540. (*----------------------------------------------------------------------*)
  541. (*                                                                      *)
  542. (*     Procedure:  Menu_Click                                           *)
  543. (*                                                                      *)
  544. (*     Purpose:    Clicks Terminal Bell                                 *)
  545. (*                                                                      *)
  546. (*     Calling Sequence:                                                *)
  547. (*                                                                      *)
  548. (*        Menu_Click;                                                   *)
  549. (*                                                                      *)
  550. (*     Calls:    Sound                                                  *)
  551. (*               Delay                                                  *)
  552. (*               NoSound                                                *)
  553. (*                                                                      *)
  554. (*----------------------------------------------------------------------*)
  555.  
  556. BEGIN (* Menu_Click *)
  557.  
  558.    IF Menu_Beep_Mode THEN
  559.       BEGIN
  560.          Sound( 2000 );
  561.          DELAY( 10 );
  562.          NoSound;
  563.       END;
  564.  
  565. END   (* Menu_Click *);
  566.  
  567. (*----------------------------------------------------------------------*)
  568. (*                Menu_Beep --- Ring Terminal Bell                      *)
  569. (*----------------------------------------------------------------------*)
  570.  
  571. PROCEDURE Menu_Beep;
  572.  
  573. (*----------------------------------------------------------------------*)
  574. (*                                                                      *)
  575. (*     Procedure:  Menu_Beep                                            *)
  576. (*                                                                      *)
  577. (*     Purpose:    Rings Terminal Bell                                  *)
  578. (*                                                                      *)
  579. (*     Calling Sequence:                                                *)
  580. (*                                                                      *)
  581. (*        Menu_Beep;                                                    *)
  582. (*                                                                      *)
  583. (*     Calls:    None                                                   *)
  584. (*                                                                      *)
  585. (*     Remarks:                                                         *)
  586. (*                                                                      *)
  587. (*        If Menu_Beep_Mode is FALSE, then '<ALERT>' is displayed in    *)
  588. (*        blinking characters on line 25 for 1 second.                  *)
  589. (*                                                                      *)
  590. (*----------------------------------------------------------------------*)
  591.  
  592. VAR
  593.    I        : BYTE;
  594.    J        : BYTE;
  595.    Save_C25 : PACKED ARRAY[1..7] OF CHAR;
  596.    Save_A25 : PACKED ARRAY[1..7] OF INTEGER;
  597.  
  598. BEGIN (* Menu_Beep *)
  599.                                    (* Generate beep if beep mode on *)
  600.    IF Menu_Beep_Mode THEN
  601.       WRITE( Ch_Bell )
  602.    ELSE                            (* Else generate blinking error  *)
  603.       BEGIN
  604.                                    (* Line 25, Column 36 *)
  605.          J     := 3913;
  606.                                    (* Save character, attribute *)
  607.          FOR I := 1 TO 7 DO
  608.             WITH Actual_Screen^ DO
  609.                BEGIN
  610.                   Save_C25[I] := CHR( Screen_Image[ J ] );
  611.                   Save_A25[I] := Screen_Image[ J + 1 ];
  612.                   J           := J + 2;
  613.                END;
  614.                                    (* Display blinking error indicator *)
  615.  
  616.          WriteSXY( '<ALERT>', 36, 25, WHITE + BLINK );
  617.  
  618.          DELAY( 1000 );
  619.                                    (* Restore previous text *)
  620.          FOR I := 1 TO 7 DO
  621.             WriteCXY( Save_C25[I], 35 + I, 25, Save_A25[I] );
  622.  
  623.       END;
  624.  
  625. END   (* Menu_Beep *);
  626.  
  627. (*----------------------------------------------------------------------*)
  628. (*                Menu_Turn_On --- Highlight Menu Choice                *)
  629. (*----------------------------------------------------------------------*)
  630.  
  631. PROCEDURE Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );
  632.  
  633. (*----------------------------------------------------------------------*)
  634. (*                                                                      *)
  635. (*     Procedure:  Menu_Turn_On                                         *)
  636. (*                                                                      *)
  637. (*     Purpose:    Highlight a menu item using reverse video            *)
  638. (*                                                                      *)
  639. (*     Calling Sequence:                                                *)
  640. (*                                                                      *)
  641. (*        Menu_Turn_On( Menu: Menu_Type; Menu_Item : INTEGER );         *)
  642. (*                                                                      *)
  643. (*           Menu      : Menu containing item to highlight              *)
  644. (*           Menu_Item : Menu entry to highlight                        *)
  645. (*                                                                      *)
  646. (*     Calls:    GoToXY                                                 *)
  647. (*               RvsVideoOn                                             *)
  648. (*               RvsVideoOff                                            *)
  649. (*                                                                      *)
  650. (*----------------------------------------------------------------------*)
  651.  
  652. BEGIN (* Menu_Turn_On *)
  653.  
  654.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  655.       BEGIN
  656.  
  657.          GoToXY( Menu_Item_Column, Menu_Item_Row );
  658.  
  659.          RvsVideoOn( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  660.  
  661.          WRITE( Menu_Item_Text );
  662.  
  663.          RvsVideoOff( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  664.  
  665.       END;
  666.  
  667. END   (* Menu_Turn_On *);
  668.  
  669. (*----------------------------------------------------------------------*)
  670. (*                Menu_Turn_Off --- UnHighlight Menu Choice             *)
  671. (*----------------------------------------------------------------------*)
  672.  
  673. PROCEDURE Menu_Turn_Off( Menu: Menu_Type; Menu_Item : INTEGER );
  674.  
  675. (*----------------------------------------------------------------------*)
  676. (*                                                                      *)
  677. (*     Procedure:  Menu_Turn_Off                                        *)
  678. (*                                                                      *)
  679. (*     Purpose:    Removes highlighting from menu item                  *)
  680. (*                                                                      *)
  681. (*     Calling Sequence:                                                *)
  682. (*                                                                      *)
  683. (*        Menu_Turn_Off( Menu : Menu_Type; Menu_Item : INTEGER );       *)
  684. (*                                                                      *)
  685. (*           Menu        : Menu containing item to unhighlight          *)
  686. (*           RvsVideoOff : Menu entry to un-highlight                   *)
  687. (*                                                                      *)
  688. (*     Calls:    GoToXY                                                 *)
  689. (*                                                                      *)
  690. (*----------------------------------------------------------------------*)
  691.  
  692. BEGIN (* Menu_Turn_Off *)
  693.  
  694.    WITH Menu.Menu_Entries[ Menu_Item ] DO
  695.       BEGIN
  696.  
  697.          GoToXY( Menu_Item_Column , Menu_Item_Row );
  698.  
  699.          RvsVideoOff( Menu.Menu_Tcolor, Menu.Menu_Bcolor );
  700.  
  701.          WRITE( Menu_Item_Text );
  702.  
  703.       END;
  704.  
  705. END   (* Menu_Turn_Off *);
  706.  
  707. (*----------------------------------------------------------------------*)
  708. (*                Menu_IBMCh --- Interpret IBM keyboard chars.          *)
  709. (*----------------------------------------------------------------------*)
  710.  
  711. PROCEDURE Menu_IBMCh( VAR C : CHAR );
  712.  
  713. (*----------------------------------------------------------------------*)
  714. (*                                                                      *)
  715. (*     Procedure:  Menu_IBMCh                                           *)
  716. (*                                                                      *)
  717. (*     Purpose:    Interpret IBM keyboard chars.                        *)
  718. (*                                                                      *)
  719. (*     Calling Sequence:                                                *)
  720. (*                                                                      *)
  721. (*        Menu_IBMCh( Var C : Char );                                   *)
  722. (*                                                                      *)
  723. (*           C --- On input, char following escape;                     *)
  724. (*                 on output, char revised to Wordstar command code.    *)
  725. (*                                                                      *)
  726. (*     Calls:   None                                                    *)
  727. (*                                                                      *)
  728. (*----------------------------------------------------------------------*)
  729.  
  730. BEGIN  (* Menu_IBMCh *)
  731.  
  732.    READ( Kbd , C );
  733.  
  734.    CASE C OF
  735.  
  736.       'H' : C := Up_arrow;
  737.       'P' : C := Down_arrow;
  738.       ELSE;
  739.  
  740.    END;
  741.  
  742. END   (* Menu_IBMCh *);
  743.  
  744. (*----------------------------------------------------------------------*)
  745. (*                Menu_Display_Choices --- Display Menu Choices         *)
  746. (*----------------------------------------------------------------------*)
  747.  
  748. PROCEDURE Menu_Display_Choices( Menu : Menu_Type );
  749.  
  750. (*----------------------------------------------------------------------*)
  751. (*                                                                      *)
  752. (*     Procedure:  Menu_Display_Choices                                 *)
  753. (*                                                                      *)
  754. (*     Purpose:    Displays Menu Choices                                *)
  755. (*                                                                      *)
  756. (*     Calling Sequence:                                                *)
  757. (*                                                                      *)
  758. (*        Menu_Display_Choices( Menu : Menu_Type );                     *)
  759. (*                                                                      *)
  760. (*           Menu --- Menu record to be displayed.                      *)
  761. (*                                                                      *)
  762. (*     Calls:   ClsScr                                                  *)
  763. (*              GoToXY                                                  *)
  764. (*              Draw_Menu_Frame                                         *)
  765. (*              Save_Screen                                             *)
  766. (*                                                                      *)
  767. (*----------------------------------------------------------------------*)
  768.  
  769. VAR
  770.    I    : INTEGER;
  771.    J    : INTEGER;
  772.    XL   : INTEGER;
  773.    YL   : INTEGER;
  774.    XR   : INTEGER;
  775.    YR   : INTEGER;
  776.    MaxX : INTEGER;
  777.    MaxY : INTEGER;
  778.  
  779. BEGIN (* Menu_Display_Choices *)
  780.  
  781.                                    (* Establish menu size *)
  782.  
  783.    XL := Menu.Menu_Column;
  784.    YL := Menu.Menu_Row;
  785.  
  786.    XR := LENGTH( Menu.Menu_Title ) + XL - 1;
  787.    YR := YL;
  788.  
  789.    MaxX := Menu.Menu_Width;
  790.    MaxY := Menu.Menu_Height;
  791.  
  792.    FOR I := 1 TO Menu.Menu_Size DO
  793.       WITH Menu.Menu_Entries[I] DO
  794.       BEGIN
  795.          IF Menu_Item_Row > MaxY THEN MaxY := Menu_Item_Row;
  796.          J := LENGTH( Menu_Item_Text ) + Menu_Item_Column - 1;
  797.          IF J > MaxX THEN MaxX := J;
  798.       END;
  799.  
  800.    J := XL + MaxX - 1;
  801.    IF J > XR THEN XR := J;
  802.  
  803.    J := YL + MaxY - 1;
  804.    IF J > YR THEN YR := J;
  805.  
  806.    XL := XL - 4;
  807.    IF XL < 0 THEN XL := 0;
  808.  
  809.    YL := YL - 1;
  810.    IF YL < 0 THEN YL := 0;
  811.  
  812.    YR := YR + 1;
  813.    IF YR > 25 THEN YR := 25;
  814.  
  815.    IF XR > 80 THEN XR := 80;
  816.  
  817.                                    (* Save current screen image *)
  818.                                    (* if not already saved      *)
  819.  
  820.    IF Current_Saved_Screen > 0 THEN
  821.       BEGIN
  822.          IF Saved_Screen_List[ Current_Saved_Screen ] <> Saved_Screen THEN
  823.             Save_Screen( Saved_Screen )
  824.       END
  825.    ELSE
  826.       Save_Screen( Saved_Screen );
  827.  
  828.                                    (* Draw the menu frame       *)
  829.  
  830.    Draw_Menu_Frame( XL, YL, XR, YR, Menu.Menu_FColor, Menu.Menu_TColor,
  831.                     Menu.Menu_Title );
  832.  
  833.                                    (* Display Menu Entries *)
  834.  
  835.    FOR I := 1 TO Menu.Menu_Size DO
  836.       WITH Menu.Menu_Entries[I] DO
  837.          BEGIN
  838.             GoToXY( Menu_Item_Column , Menu_Item_Row );
  839.             WRITE( Menu_Item_Text );
  840.          END;
  841.                                    (* Highlight Default Choice *)
  842.  
  843.    Menu_Turn_On( Menu, Menu.Menu_Default );
  844.  
  845. END   (* Menu_Display_Choices *);
  846.  
  847. (*----------------------------------------------------------------------*)
  848. (*                Menu_Get_Choice --- Get Menu Choice                   *)
  849. (*----------------------------------------------------------------------*)
  850.  
  851. FUNCTION Menu_Get_Choice( Menu: Menu_Type; Erase_After: BOOLEAN ) : INTEGER;
  852.  
  853. (*----------------------------------------------------------------------*)
  854. (*                                                                      *)
  855. (*     Function:  Menu_Get_Choice                                       *)
  856. (*                                                                      *)
  857. (*     Purpose:   Retrieves Menu Choice from current menu               *)
  858. (*                                                                      *)
  859. (*     Calling Sequence:                                                *)
  860. (*                                                                      *)
  861. (*        Ichoice := Menu_Get_Choice( Menu       : Menu_Type;           *)
  862. (*                                    Erase_After: BOOLEAN ) : INTEGER; *)
  863. (*                                                                      *)
  864. (*           Menu        --- Currently displayed menu                   *)
  865. (*           Erase_After --- TRUE to erase menu after choice found      *)
  866. (*           Ichoice     --- Returned menu item chosen                  *)
  867. (*                                                                      *)
  868. (*      Calls:   Menu_Click                                             *)
  869. (*               Menu_IBMCh                                             *)
  870. (*               Menu_Turn_Off                                          *)
  871. (*               Menu_Turn_On                                           *)
  872. (*                                                                      *)
  873. (*      Remarks:                                                        *)
  874. (*                                                                      *)
  875. (*         The current menu item is highlighted in reverse video.       *)
  876. (*         It may be chosen by hitting the return key.  Movement        *)
  877. (*         to other menu items is done using the up-arrow and           *)
  878. (*         down-arrow.                                                  *)
  879. (*                                                                      *)
  880. (*         An item may also be chosen by hitting the first character    *)
  881. (*         of that item.                                                *)
  882. (*                                                                      *)
  883. (*----------------------------------------------------------------------*)
  884.  
  885. VAR
  886.    C       : CHAR;
  887.    Current : INTEGER;
  888.    Last    : INTEGER;
  889.    I       : INTEGER;
  890.    Found   : BOOLEAN;
  891.  
  892. BEGIN  (* Menu_Get_Choice *)
  893.  
  894.    Current := Menu.Menu_Default;
  895.  
  896.    Last    := Current - 1;
  897.    IF Last < 1 THEN Last := Menu.Menu_Size;
  898.  
  899.    REPEAT  (* Loop until return key hit *)
  900.  
  901.                                    (* Read a character *)
  902.       READ( Kbd , C );
  903.       Menu_Click;
  904.       C := UpCase( C );
  905.                                    (* Convert character to menu code *)
  906.       IF C = Ch_Esc THEN Menu_IBMCh( C );
  907.                                    (* Process character *)
  908.       CASE C OF
  909.  
  910.          Down_arrow,
  911.          Space_bar     : BEGIN (* Move down menu *)
  912.                             Last    := Current;
  913.                             Current := Current + 1;
  914.                             IF Current > Menu.Menu_Size THEN
  915.                                Current := 1;
  916.                          END;
  917.  
  918.          Up_arrow      : BEGIN (* Move up menu *)
  919.                             Last    := Current;
  920.                             Current := Current - 1;
  921.                             IF Current < 1 THEN
  922.                                Current := Menu.Menu_Size;
  923.                          END   (* Move up menu *);
  924.  
  925.          Ch_Cr         : ;
  926.  
  927.          ELSE
  928.  
  929.             Found := FALSE;
  930.  
  931.             FOR I := 1 TO Menu.Menu_Size DO
  932.                IF C = UpCase( Menu.Menu_Entries[I].Menu_Item_Text[1] ) THEN
  933.                   BEGIN
  934.                      Found   := TRUE;
  935.                      C       := Ch_Cr;
  936.                      Last    := Current;
  937.                      Current := I;
  938.                   END;
  939.  
  940.             IF ( NOT Found ) THEN Menu_Beep;
  941.  
  942.       END (* Case of C *);
  943.                                    (* Highlight new menu choice *)
  944.  
  945.       IF C IN [ Up_arrow, Down_arrow, Space_bar, Ch_Cr ] THEN
  946.          BEGIN
  947.             Menu_Turn_Off( Menu, Last    );
  948.             Menu_Turn_On ( Menu, Current );
  949.          END;
  950.  
  951.    UNTIL C = Ch_CR;
  952.  
  953.                                    (* Return index of chosen value *)
  954.    Menu_Get_Choice := Current;
  955.  
  956.                                    (* Erase menu from display      *)
  957.    IF Erase_After THEN
  958.       BEGIN                        (* Restore previous screen      *)
  959.          Restore_Screen( Saved_Screen );
  960.                                    (* Restore global colors        *)
  961.          Reset_Global_Colors;
  962.       END;
  963.  
  964. END   (* Menu_Get_Choice *);
  965.